home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp2.arc / INIT.LSP < prev    next >
Text File  |  1985-01-01  |  2KB  |  67 lines
  1. ; get some more memory
  2. (expand 1)
  3.  
  4. ; some fake definitions for Common Lisp pseudo compatiblity
  5. (setq symbol-function symbol-value)
  6. (setq fboundp boundp)
  7. (setq first car)
  8. (setq second cadr)
  9. (setq rest cdr)
  10.  
  11. ; some more cxr functions
  12. (defun caddr (x) (car (cddr x)))
  13. (defun cadddr (x) (cadr (cddr x)))
  14.  
  15. ; (when test code...) - execute code when test is true
  16. (defmacro when (test &rest code)
  17.           `(cond (,test ,@code)))
  18.  
  19. ; (unless test code...) - execute code unless test is true
  20. (defmacro unless (test &rest code)
  21.           `(cond ((not ,test) ,@code)))
  22.  
  23. ; (makunbound sym) - make a symbol be unbound
  24. (defun makunbound (sym) (setq sym '*unbound*) sym)
  25.  
  26. ; (objectp expr) - object predicate
  27. (defun objectp (x) (eq (type x) 'OBJ))
  28.  
  29. ; (filep expr) - file predicate
  30. (defun filep (x) (eq (type x) 'FPTR))
  31.  
  32. ; (unintern sym) - remove a symbol from the oblist
  33. (defun unintern (sym) (cond ((member sym *oblist*)
  34.                              (setq *oblist* (delete sym *oblist*))
  35.                              t)
  36.                             (t nil)))
  37.  
  38. ; (mapcan ...)
  39. (defmacro mapcan (&rest args) `(apply #'nconc (mapcar ,@args)))
  40.  
  41. ; (mapcon ...)
  42. (defmacro mapcon (&rest args) `(apply #'nconc (maplist ,@args)))
  43.  
  44. ; (save fun) - save a function definition to a file
  45. (defun save (fun)
  46.        (let* ((fname (strcat (symbol-name fun) ".lsp"))
  47.               (fp (openo fname)))
  48.              (cond (fp (print (cons (if (eq (car (eval fun)) 'lambda)
  49.                                         'defun
  50.                                         'defmacro)
  51.                                     (cons fun (cdr (eval fun)))) fp)
  52.                        (close fp)
  53.                        fname)
  54.                    (t nil))))
  55.  
  56. ; (debug) - enable debug breaks
  57. (defun debug ()
  58.        (setq *breakenable* t))
  59.  
  60. ; (nodebug) - disable debug breaks
  61. (defun nodebug ()
  62.        (setq *breakenable* nil))
  63.  
  64. ; initialize to enable breaks but no trace back
  65. (setq *breakenable* t)
  66. (setq *tracenable* nil)
  67.